home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / boi120p.zip / HILO.PAS < prev    next >
Pascal/Delphi Source File  |  1990-12-12  |  7KB  |  248 lines
  1. {$D-}
  2. {$S-}
  3. {$V-}
  4.  
  5. program HiLo;
  6. { Copyright (C) 1990 Andrew J. Mead
  7.   All Rights Reserved.
  8.   Contact POB 1155 Chapel Hill, NC 27514-1155 }
  9.  
  10. { Version 0.1  beta dated 12/12/90 using BBS Onliner Interface 1.20
  11.   Version 1.07 12/11/90 BOI 1.20
  12.  
  13. }
  14.  
  15. Uses
  16.   dos,
  17.   boidecl,
  18.   getcmbbs,
  19.   iolib,
  20.   support;
  21.  
  22. Const
  23.   version    = '1.00';
  24.   regnum     = '';
  25.   regstr     = 'Unregistered Version';
  26.   registered = false;
  27.  
  28. {  registered users
  29. }
  30.  
  31. Const
  32.   hoffile    = 'Hilohof.dat';
  33.  
  34. Var
  35.   hilonum    : word;        {  computer's number  }
  36.  
  37.   gotit      : boolean;     {  player success indicator  }
  38.   quit       : boolean;     {  player quit indicator     }
  39.   inchar     : char;        {  standard input variable   }
  40.  
  41. Procedure GETINSTRUCTIONS;
  42.   begin {* GetInstructions *}
  43.     PortWindow(1,1,80,pagelength);
  44.     ClrPortScr;
  45.     PortColor(yellow,white);
  46.     SendString('HI-LO',false);
  47.     PortColor(cyan,lightgray);
  48.     SendString('',true);
  49.     SendString('The object of Hi-Lo is to guess the correct number in as few as a turns as',true);
  50.     SendString('necessary.  The computer has chosen a number from 1 to 1024.  After each',true);
  51.     SendString('guess, you''ll be told whether the guess was correct, too high, or too low.',true);
  52.  
  53.     SendString('The other commands are ''Q'' to quit the game,''I'' to review these',true);
  54.     SendString('instructions, or ''T'' to check time remaining (if it is available.',true);
  55.     SendString('',true);
  56.     PortColor(yellow,white);
  57.     SendString('',true);
  58.     SendString('Press almost any key to continue game.',false);
  59.     ClearBuffers;
  60.     inchar := ReadPortKey
  61.   end;  {* GetInstructions *}
  62.  
  63. Procedure INITIALIZE;
  64.   begin {* Initialize *}
  65.     randomize;
  66.     hilonum := random(1024) + 1;
  67.     quit := false;
  68.     playerpoints := 0;
  69.     gotit := false
  70.   end;  {* Initialize *}
  71.  
  72. Procedure PLAYGAME;
  73.   var
  74.     moved : boolean;
  75.     linein : string;
  76.  
  77.   Procedure SHOWSCREEN;
  78.     begin {* PlayGame,ShowScreen *}
  79.       PortWindow(1,1,80,pagelength);
  80.       ClrPortScr;
  81.       PortColor(cyan,lightgray);
  82.       SendString('Hi-Lo Guessing Game',false);
  83.       GotoPortXY(1,18);
  84.       TextPortColor(lightgray);
  85.       SendString('Hi-Lo options: ',false);
  86.       LineWrite('[I]nstructions   ',true);
  87.       LineWrite('[T]ime   ',usetime);
  88.       LineWrite('[Q]uit',true)
  89.     end;  {* PlayGame,ShowScreen *}
  90.  
  91.   Procedure WRITELINE;
  92.     begin {* PlayGame,WriteLine *}
  93.       ClrPortScr;
  94.       TextPortColor(lightgray);
  95.       if usetime then
  96.         begin
  97.           If LeftTime <= 0 then
  98.             begin
  99.               SendString('Your time limit has expired.  Game is being exited.',true);
  100.               timexp := true;
  101.               exit
  102.             end
  103.           else if LeftTime < 4 then SendString(#7 + 'You have less than ' +
  104.               IntStr(LeftTime,0) + ' minutes left.',true)
  105.         end;
  106.       SendString('You have made '+ IntStr(playerpoints,0) + ' guesses. ',true);
  107.       PortColor(yellow,lightgray);
  108.       SendString('Enter your guess: ',false)
  109.     end;  {* PlayGame,WriteLine *}
  110.  
  111.   Procedure GETINPUT;
  112.     begin {* PlayGame,GetInput *}
  113.       repeat
  114.         begin
  115.           inchar := ReadPortKey;
  116.           if not (upcase(inchar) in ['1'..'9','Q','I','T']) then
  117.               SendString(#7,false)
  118.         end
  119.       until upcase(inchar) in ['1'..'9','Q','I','T'];
  120.       TextPortColor(white);
  121.       case upcase(inchar) of
  122.           'Q' :
  123.             begin
  124.               SendString('Quit',true);
  125.               SendString('Do you really want to quit? [Y/N] ',false);
  126.               repeat inchar := upcase(ReadPortKey) until inchar in ['Y','N'];
  127.               if inchar = 'Y' then
  128.                 begin
  129.                   quit := true;
  130.                   SendString('Yes',true)
  131.                 end
  132.               else SendString('No',false)
  133.             end;
  134.           'I' :
  135.             begin
  136.               GetInstructions;
  137.               ShowScreen;
  138.               PortWindow(1,20,80,pagelength)
  139.             end;
  140.           'T' :
  141.             begin
  142.               PortWindow(1,20,80,pagelength);
  143.               ClrPortScr;
  144.               GotoPortXY(1,1);
  145.               if usetime then SendString('You have less than ' +
  146.                   IntStr(LeftTime,0) + ' minutes remaining.',false)
  147.               else SendString('This function is not operational.',false);
  148.               GotoPortXY(1,2);
  149.               SendString('Press almost any key to continue. ',false);
  150.               ClearBuffers;
  151.               inchar := ReadPortKey;
  152.               ClrPortScr
  153.             end
  154.           else
  155.             begin
  156.               SendString(inchar,false);
  157.               GetString(linein);
  158.               linein := inchar + linein;
  159.               moved := true
  160.             end
  161.         end
  162.     end;  {* PlayGame,GetInput *}
  163.  
  164.   Procedure PROCESSGUESS;
  165.     var
  166.       guessamount : word;
  167.       dummy       : word;
  168.  
  169.     begin {* PlayGame,ProcessGuess *}
  170.       Val(linein,guessamount,dummy);
  171.       PortWindow(1,1,80,pagelength);
  172.       if (dummy = 0) and (guessamount > 0) and (guessamount < 1024) then
  173.         begin
  174.           Inc(playerpoints);
  175.           GotoPortXY(1,12);
  176.           ClrPortEOL;
  177.           if guessamount = hilonum then
  178.             begin
  179.               PortColor(lightred + blink,white + blink);
  180.               SendString('Congratulations!!!',false);
  181.               PortColor(lightgreen,white);
  182.               SendString('  You''ve Done It!!!',false);
  183.               gotit := true
  184.             end
  185.           else
  186.             begin
  187.               TextPortColor(lightgray);
  188.               SendString('Your guess is ',false);
  189.               if guessamount < hilonum then
  190.                 begin
  191.                   PortColor(lightblue,lightgray);
  192.                   SendString('Too Low',false)
  193.                 end
  194.               else
  195.                 begin
  196.                   PortColor(yellow,lightgray);
  197.                   SendString('Too High',false)
  198.                 end
  199.             end
  200.         end
  201.       else SendString(#7#7#7,false)
  202.     end;  {* PlayGame,ProcessGuess *}
  203.  
  204.   begin {* PlayGame *}
  205.     ShowScreen;
  206.     repeat
  207.       begin
  208.         PortWindow(1,20,80,pagelength);
  209.         moved := false;
  210.         repeat
  211.           begin
  212.             WriteLine;
  213.             if not timexp then GetInput
  214.           end
  215.         until moved or quit or timexp;
  216.         if not (quit or timexp) then ProcessGuess
  217.       end;
  218.     until quit or gotit or timexp;
  219.     PortWindow(1,20,80,pagelength);
  220.     ClrPortScr;
  221.     TextPortColor(lightgray)
  222.   end;  {* PlayGame *}
  223.  
  224. begin
  225.   GetCommand('BBSNOTES.DOC','HiLoHOF.Txt','HiLoErr.Log','Hi-Lo',version,[]);
  226.   SetPort;
  227.   If pagelength < 23 then AbortGame(23);
  228.   QueryUser;
  229.   if WriteCopy('HiLo',version,regnum,regstr,'',registered,false,true) then GetInstructions;
  230.   repeat
  231.     begin
  232.       Initialize;
  233.       PlayGame;
  234.       EndGame('HiLo','Guessers',regstr,hoffile,registered,gotit,false,false)
  235.     end
  236.   until not doagain;
  237.   EndPort
  238. end.
  239.  
  240. Copyright (C) 1990 Andrew J. Mead
  241. All Rights Reserved.
  242.  
  243. For further information, contact:
  244. The Mad Programmer
  245. Andrew J. Mead
  246. POB 1155
  247. Chapel Hill, NC 27514-1155
  248.